perm filename UNDER[POX,WD]1 blob
sn#358978 filedate 1978-05-31 generic text, type T, neo UTF8
00100 \|\\; Define Brick Character
00200 \M0FIX25;\; fixed font
00300 \⊂'000040;\; VERREM - REM's syntax form macros with args definitions
00400 \⊂'000400;\; VERRHT - modified way to pass args with nest chars
00500 \8EVAL(STRING)[⊗STRING⊗]\;
00600 \8OMIT(STRING)[]\;
00700 \8SETOM(REG)[\P\←=1;\→⊗REG⊗\p]\; set REG to one
00800 \8SETZM(REG)[\P\←=0;\→⊗REG⊗\p]\; set REG to zero
00900 \8LOADAC(VAR)[\!EVAL((\←=)\!⊗VAR⊗;(;));]\; load ac with var
01000 \∞TRACEAC[\!EVAL((\m{)(ac=)\D∀( )(}));]\; trace ac
01100 \;
01200 \8INCR(VAR)[\N increment variable
01300 \ ;\P\N save ac
01400 \ ;\!LOADAC(⊗VAR⊗);\N load ac with var
01500 \ ;\!EVAL((\∂←)⊗VAR⊗(;));\N expunge old var def
01600 \ ;\+=1;\N add 1 to ac
01700 \ ;\!EVAL((\∞)⊗VAR⊗([)\D∀(]));\N
01800 \ ;\N redefine var
01900 \ ;\p]\; restore ac
02000 \;
02100 \8COMPAC(ARG)[\N complement ac
02200 \ ;\!EVAL(⊗ARG⊗);\N evaluate argument
02300 \ ;\Q0\N save reg 0
02400 \ ;\!SETOM(0);\N put a 1 in reg 0
02500 \ ;\?SETZM(0);\N if ac > 0 set reg 0 to 0
02600 \ ;\←0\N load ac from reg 0
02700 \ ;\q0]\; restore reg 0
02800 \;
02900 \∞ISACZERO[\N is ac zero
03000 \ ;\Q0\N save qreg 0
03100 \ ;\→0\N store ac in 0
03200 \ ;\*0\N mult ac by qreg 0
03300 \ ;\!COMPAC;\N complement ac
03400 \ ;\q0]\; restore qreg 0
03500 \;
03600 \8LENGTH(STRING)[\N length of string
03700 \ ;\Q0\N save reg 0
03800 \ ;\oSP{0 }\N put a space in an overlay
03900 \ ;\7SP;\N width of space to ac
04000 \ ;\∂←SP;\N expunge overlay
04100 \ ;\→0\N store ac in reg 0
04200 \ ;\oSTR{0 ⊗STRING⊗}\N put string in overlay
04300 \ ;\7STR;\N width of string to ac
04400 \ ;\∂←STR;\N expunge overlay
04500 \ ;\-0\N subtract off width of space
04600 \ ;\/0\N divide by width of space
04700 \ ;\q0]\; restore reg 0
04800 \;
04900 \8NULL(STRING)[\!COMPAC(\!LENGTH(⊗STRING⊗););]\N
05000 \;
05100 \8FIRST(STRING)[\N first character of a string
05200 \ ;\P\N save ac
05300 \ ;\!OMIT(\a⊗STRING⊗);\N ascii of 1st char to ac
05400 \ ;\N and flush rest of string
05500 \ ;\A∀\N make char from ac
05600 \ ;\p]\; restore ac
05700 \;
05800 \8REST(STRING)[\N rest of a string
05900 \ ;\P\N save ac
06000 \ ;\a⊗STRING⊗\N carve off 1st char
06100 \ ;\p]\; restore ac
06200 \;
06300 \8MAPFIRST(MAC,STR)[\N apply macro to each char of string
06400 \ ;\P\N save ac
06500 \ ;\!COMPAC(\!NULL(⊗STR⊗););\N if string is not null
06600 \ ;\?⊗MAC⊗(\?FIRST(⊗STR⊗););\N
06700 \ ;\N apply macro to first char
06800 \ ;\?MAPFIRST(⊗MAC⊗,\?REST(⊗STR⊗););\N
06900 \ ;\N apply macro to rest of string
07000 \ ;\p]\; restore ac
07100 \;
07200 \8ISCRLF(CHAR)[\N is char a cr or lf
07300 \ ;\a⊗CHAR⊗\N ascii of char to ac
07400 \ ;\P\N push ac
07500 \ ;\-=13;\N sub ascii of cr from ac
07600 \ ;\!COMPAC(\!ISACZERO;);\N was it a cr
07700 \ ;\?EVAL((\p\N get back ascii of char
07800 \ ;\-=10;\N sub ascii of lf
07900 \ ;\!COMPAC(\!ISACZERO;);));\N was it a lf
08000 \ ;\!COMPAC;]\; restore pos logic
08100 \;
08200 \8UNDERLINE(STR)[\!MAPFIRST(UNDERLINECHAR,⊗STR⊗);]\;
08300 \;
08400 \8UNDERLINECHAR(CHAR)[\N underline non crlf chars
08500 \ ;\P\N save ac
08600 \ ;\!COMPAC(\!ISCRLF(⊗CHAR⊗););\N if not cr or lf
08700 \ ;\?UNDERLINECHAR1(⊗CHAR⊗);\N underline it
08800 \ ;\!COMPAC;\N complement ac
08900 \ ;\?INCR(UNDCNT);\N
09000 \ ;\?EVAL(⊗CHAR⊗);\N pass bare char
09100 \ ;\p]\; restore ac
09200 \;
09300 \8UNDERLINECHAR1(CHAR)[\[=2;=2;⊗CHAR⊗\]]\;
09400 \8UNDERLINECHAR1(CHAR)[\N *****
09500 \ ;\[=2;=2;⊗CHAR⊗\]\N
09600 \ ;\!INCR(UNDCNT);
09700 \!EVAL((\m{)\!UNDCNT;( )(}));]\;
09800 \∞UNDCNT[0]\; *****
09900 \;
10000 \∞FOO[\N macro to iterate underline
10100 \ ;\-=1;\N decrement count
10200 \ ;\P\N
10300 \ ;\!UNDERLINE(a);\N
10400
10500 \ ;\p]\;
10600 \←=1000;\; iteration count
10700 \IFOO;\;
10800 \8PRINTCHARS(STR)[\!MAPFIRST(PRINTCHAR,⊗STR⊗);]\;
10900 \;
11000 \8PRINTCHAR(CH)[
11100 \ ;\P\N save ac
11200 \ ;\a⊗CH⊗\N ascii of char to ac
11300 \ ;\!EVAL((\m{)\D∀( )(}));\N trace ac
11400 \ ;\!ISCRLF(⊗CH⊗);\N
11500 \ ;\!EVAL((\m{)\D∀( )(}));\N trace ac
11600 \ ;\p]\; restore ac
11700 \;